perm filename GULI[F8,ALS] blob
sn#306688 filedate 1977-09-28 generic text, type C, neo UTF8
COMMENT ā VALID 00022 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 *CHECKERS REV 0.12
C00007 00003 * MAIN PROGRAM STARTS HERE
C00019 00004 *Subroutine to find square indicated by cursor
C00025 00005 * Code to read the internal representation of the board and to put the
C00033 00006 * Subroutine to move data from RAM to S O'30' thru O'47' with the data for
C00038 00007 *MAP Code to convert joystick reading into cursor position on board.
C00043 00008 ORG H'17C0'
C00055 00009 ORG H'1980'
C00062 00010 * FKT GMEN RFJN LFJN STMV
C00066 00011 * NEXT FIND RFJ LFJ RBJ LBJ
C00072 00012 * JUMT AFTC
C00074 00013 * AFT MAKE OKMV PMRT
C00077 00014 * RFN LFN RBN LBN NORT NORF NOR2 NOR3 NOR4
C00080 00015 * SELECT SELE
C00084 00016 * JUMP
C00090 00017 * NORM FORE
C00092 00018 * EVAL
C00096 00019 * SQIN SQOU MVIN
C00101 00020 * TELL
C00103 00021 * BOOK
C00106 00022
C00118 ENDMK
Cā;
*CHECKERS REV 0.12
* DATE 8/12/77 VERSION ALS
*
*Resident package addresses
JOYT EQU H'0C00'
LINE EQU H'0FDF'
SHCB EQU H'0FE2'
INPF EQU H'0FE3'
WTLN EQU H'0FE5'
TXC EQU H'0FE8'
CMRG EQU H'0FEA'
DBNC EQU H'0FEB'
UPI EQU H'0FFA'
*JOYI EQU H'21C4' Using internal copy
IJS EQU H'22DC'
PUSH EQU H'4097'
POPS EQU H'40AA'
SPS EQU H'40BE'
WMS EQU H'41FD'
UDAT EQU H'4245'
FCS EQU H'43BE'
WAIT EQU H'44E9'
TIR EQU H'45C3'
*Misc. constants
TCMD EQU H'44'
BCMD EQU H'6D'
TCOL EQU H'80' TEXT COLOR
ULIN EQU H'E5'
COM EQU H'8F7'
SLT EQU SKL
*
*RAM assignments
JOYK EQU H'0B23' 0 if JOY, FF if KEYBOARD
OBJ0 EQU H'C30'
TREE EQU H'0E10' Tree data (15 blocks of 16 bytes each)
BLCK EQU H'0E10'
RED EQU H'0E20'
JSAV EQU H'0E50' Temp store of Joystick readings
PLMD EQU H'0EC0' Used for temp store of player's move info
PLMV EQU H'0ED0' Overlay region used for player's moves
PLMF EQU H'0EE0' and move numbers
MOBS EQU H'0F00' Mobility and DJ flags (14 bytes)
OBJ1 EQU H'F10' BOARD 2
*
*Scratch pad assignments
J EQU H'9'
HU EQU H'A'
HL EQU H'B'
PLOC EQU O'3' LISU value for ACTIVE and PASSIVE
KLOC EQU O'4' LISU value for KING's and special data
ELOC EQU O'5' LISU value for EMPTY's area
ISA EQU O'30' ISAR value for active area
ISP EQU O'34' ISAR value for passive
ISK EQU O'40' ISAR value for kings
ISE EQU O'51' ISAR value for empty (with offset)
*Mimimum ply depths
PLYT EQU H'FE' Ply depth for Robot Tom (stored as neg.)
PLYD EQU H'FD' Ply depth for Robot Dick
PLYH EQU H'FC' Ply depth for Robot Harry
*
ORG H'1000'
DC H'AA'
DC H'55'
DC H'00' BACKGROUND COLOR
DC H'00' BACKGROUND COLOR
DC H'00' SPACES
DC H'00' SPACES
DC H'3119' CH
DC H'0B31' EC
DC H'150B' KE
DC H'0921' RS
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
*
* MAIN PROGRAM STARTS HERE
*
PI SPS
*
* SET INTERRUPT VECTOR
*
* SET LINE INTERRUPT
*
DI DISABLE INTRPT
*This code for compilers that accept : and .
LI INHR: Set INT vector in SMI
OUTS H'C'
LI INHR.
*This code for compilers that do not accept : and .
* DCI INHR
* LR Q,DC
* LR A,QU
* OUTS H'C'
* LR A,QL
*End of substitution
OUTS H'D'
LIS H'0'
OUTS H'E' Disable SMI INT
*First question to define skill level
PI TINT TEXT INIT
LISU O'2'
LISL O'4'
LI H'40' H40=D64
LR S,A SET REG24
DCI LINE
LI H'20' LINE # 2 POS. 0
ST
DCI SKL SKILL LEVEL TABLE
PI WMS WRITE MESSAGE
PI RKB READ KEYBOARD
CI H'1F' IS IT DICK?
BNZ QN12 No
LI PLYD
BR QN14
QN12 CI H'19' IS IT HARRY?
BNZ QN13 No, it must be Tom
LI PLYH
BR QN14
QN13 LI PLYT
QN14 DCI PLY0
ST
*Second question joystick vs keyboard
PI TINT INIT.TEXT
LISU O'2'
LISL O'4' SET ISAR
LI H'30' #OF CHARS.
LR S,A PUT IT IN '24'
DCI LINE
LI H'30' LINE 3 POS.0
ST
DCI INJK TEXT TABLE ADDR.
PI WMS
PI RKB READ KEYBOARD
CI H'15' IS IT K?
LIS H'F' F if keyboard
BZ INJ It is K
PI IJS Init joystick
CLR 0 if joystick
INJ DCI JOYK
ST
*Third question play black or red
PI TINT TXT INIT
LISU O'2'
LISL O'4'
LI H'1A' H1A=D CHARS.
LR S,A PUT IT IN 24
DCI LINE
LI H'30'
ST
DCI YMF
PI WMS
PI RKB GET ANSWER FROM KBD
CI H'2B' IS IT 'N'?
CLR
DCI COL0
BZ QN31 ITS N
ST
DCI BLCK DEF. BLACK
BR QN32
QN31 COM
ST
DCI RED
QN32 LR H,DC PUT IT IN H
**** FIX NEEDED HERE
*IF ANSWER IS N WE WILL HAVE TO JMP TO ANOTHER LOCATION
*Now set up board
PI BRDI Set up initial board
DCI JSAV Initialize for first read of joystick
LIS H'F' Anything greater than 7
ST
ST
*Get available black moves from table BLKM
DCI PLMV
XDC
DCI BLKM
LIS H'6'
LR 0,A
PLML LM
XDC
ST
XDC
DS 0
BP PLML
****PUT CODE HERE TO TELL PLAYER THAT IT IS TIME FOR HIM TO MOVE
CUR1 PI CURS Follow cursor to identify piece
NOP We'll need time to check piece
NOP
NOP
NOP
DI Disable CPU interrupt
* DCI CMRG Reset INT bit in COM reg
* LR Q,DC
* LM
* OI H'21'
* NI H'F7'
* LR DC,Q
* ST
* DCI COM
* ST
* EI
NOP
NOP
NOP
NOP
*This code for compilers that accept : and .
LI INHR: Set INT vector in SMI
OUTS H'C'
LI INHR.
*This code for compilers that do not accept : and .
* DCI INHR
* LR Q,DC
* LR A,QU
* OUTS H'C'
* LR A,QL
*End of substitution
OUTS H'D'
LI ULIN Set Y INT reg to E5
DCI H'8F0'
ST
LIS H'08' Set INT bit in COM reg
DCI CMRG
LR Q,DC
OM
LR DC,Q
ST
DCI COM
ST
LIS 1
OUTS H'E' Enable SMI INT
EI Enable CPU INT
BR * TEST LOOP FOR ABOVE
JMP OKPI
OKNO CLR Clear 3 to show that piece cannot move
LR 3,A
*We will now have to signal that he has picked a piece that can move but
*it can not move to the square chosen and that the player is to try again
****PUT CODE HERE TO TELL PLAYER THAT PIECE CANNOT MOVE AND TO TRY AGAIN
*We will want th indicate failure, perhaps by a growl before going back
*to letting the player try to find a piece that can move
BR CUR1
* Code to verify that indicated piece can, in fact, move.
* The byte showing the piece is in 3 and the byte # is in 4 without
* the jump bit and the direction as yet.
OKPI DCI PLMV Possible moves listing
LM Number of entries here
ADC
CLR
ST Set zero to stop search
DCI PLMV
LM Skip the number of entries
OKP1 LM Get first move byte
NI H'FF'
BZ OKNO No more entries
NS 3
BNZ OKP2 This might be the one
CM A cheap way to index
BR OKP1 Try again
OKP2 LM Next entry is the byte info
NI H'0C' Remove the J bit and the direction
XS 4 Does it match?
BNZ OKP1 Try again
LR Q,DC
XDC Save data position
DCI PLMD Save data as to starting square
LR A,QU So we can use Q freely if need be
ST
LR A,QL
ST
LR A,1
ST Save the normalized X position
LR A,2
ST and the normalized Y position
LR A,3
ST Save player's starting byte
LR A,4
ST and the Byte number
*We may want to signal the success by some audible signal
LR A,0
*Similar code to test destination goes in here
CUR2 PI CURS Follow cursor to identify destination
NOP We'll need time to check move
NOP
NOP
NOP
BR *
*This code for compilers that accept : and .
LI INHR: Set INT vector in SMI
OUTS H'C'
LI INHR.
*This code for compilers that do not accept : and .
* DCI INHR
* LR Q,DC
* LR A,QU
* OUTS H'C'
* LR A,QL
*End of substitution
OUTS H'D'
LI ULIN Set Y INT reg to E5
DCI H'8F0'
ST
LIS H'08' Set INT bit in COM reg
DCI CMRG
LR Q,DC
OM
LR DC,Q
ST
DCI COM
ST
LIS 1
OUTS H'E' Enable SMI INT
EI Enable CPU INT
*Now test indicated move for legality
OKMV DCI PLMD
LM
LR QU,A
LM
LR QL,A
LM Get the old X value
COM
INC
AS 1 This gives us the change in X
LR 5,A
LM Get the old Y value
COM
INC
AS 2
LR 6,A
BM OKM4
CI H'01'
BZ OKM2 It was a normal forward move
CI H'02'
BNZ NONO Not a legal move
LR A,5
CI H'02'
BNZ OKM1
LI H'10' A RFJ move
BR OKN Still must make sure
OKM1 CI H'FE'
BNZ NONO
LI H'11' A LFJ move
BR OKN
OKM2 LR A,5
CI H'01'
BNZ OKM3
CLR A RFN move
BR OKN
OKM3 CI H'FF'
BNZ NONO
LIS H'01' A LFN move
BR OKN
OKM4 CI H'FF'
BZ OKM6
CI H'FE'
BNZ NONO
LR A,5
CI H'02'
BNZ OKM5
LI H'12' A RBJ jump
BR OKN
OKM5 CI H'FE'
BNZ NONO
LI H'13' A LBJ jump
BR OKN
OKM6 LR A,5
CI H'01'
BNZ OKM7
LI H'01' A RBN move
BR OKN
OKM7 CI H'FF'
BNZ NONO
LI H'11' A LBN move
OKN AS 4 Add the byte number
LR 4,A and save the complete byte info
LI H'FF' Back up
ADC
OKN2 LR A,4
CM Is it the same?
BZ OKOK Found!
OKN3 LM Go to the next entry
NI H'FF'
BZ NONO
NS 3
BNZ OKN2 A bit matches here
CM A cheap way to index
BR OKN3
*Player has selected an impossible destination
NONO NOP
DCI PLY0
LM
CI PLYT
BZ NON2
****PUT MESSAGE HERE THAT DESTINATION IS IMPOSSIBLE AND TO TRY AGAIN
****NOTE THAT WHEN PLAYING DICK OR HARRY THE PLAYER MUST MOVE A PIECE THAT
****CAN MOVE, ONCE HE HAS TOUCHED IT
JMP CUR2
NON2 NOP
****PUT CODE HERE GIVING TOM PLAYERS THE CHOICE OF SELECTING A DIFFERENT PIECE
****IF HE WANTS TO DO THIS ELSE HE MAY SIMPLY SELECT A DIFFERENT DESTINATION
JMP CUR1
OKOK NOP
**** ACKNOWLEDGE ACCEPTABLE MOVE HERE
*Remove cursor
DCI JSAV
LM
LR 1,A
LM
LR 4,A
PI MAPS This removes cursor
*Move piece
*Tree routine goes in here
*On completion of tree search we compute all of the possible moves for
*the player and store them at PLMV before making the move and signalling
*the player that it is now his move, and return to CUR1
JMP CUR1
*
*
*
*
*Subroutine to find square indicated by cursor
CURS LR K,P
PI PUSH
LI H'E5'
DCI WTLN
ST
NOP
NOP
NOP
NOP
PI MAP
NOP
NOP
NOP
NOP
OUTS 1
CLR Read push button
INS 1
NI 1
BZ CURS Loop until button is pushed
PI POPS
PK
* TINT TEXT INITIALIZATION
TINT LR K,P SAVE RETURN
PI PUSH
PI RST RESET UM1 REGS.
TNT1 DCI H'8FB'
LIS H'8'
XM
BNZ TNT1
DCI CMRG PROG COPY OF COM REG.
LI TCMD DISPLAY COMMAND
ST
DCI H'C18'
CLR
ST
DCI WTLN
LI ULIN WAIT LINE
ST
DCI TXC TEXTCOLOR
LI TCOL
ST
PI TIR CALL TEXT INIT
PI POPS
PK
*
**********************************************************
*
* RST RESETS UM1 REGS.
*
**********************************************************
RST LR K,P CLR R/W REGS.
LI H'80'
LR 0,A
LI H'FF'
DCI H'800'
RST1 ST
DS 0
BNZ RST1
DCI H'8F0' CLR WRITE ONLY REGS
LIS H'8'
LR 0,A
CLR
RST2 ST
DS 0
BNZ RST2
PK
*
**************************************************************
*
* KEYBORD READ
*
**************************************************************
RKB LR K,P
PI PUSH
CLR
DCI INPF CLEAR FLAG
ST
DCI DBNC
ST
DCI SHCB CLER SHIFT CONTROL
ST
DCI CMRG
LI TCMD
ST
LISU O'2'
LISL O'4'
LI H'C0' WAIT TIME FOR FCS
LR S,A PUT IT IN '24'
RKB1 PI FCS GET CHAR.
BZ RKB1 WAIT FOR ANY KEY
LR A,8 RETURN CHAR IN AC
PI POPS
PK
*
************************************************************************
*
* BOARD IMAGE ROUTINE
*
******************************************
*
BRDI LR K,P SAVE RETURN
NOP
NOP
NOP
PI PUSH
PI RST RESET UM1 REG
PI BORD GENERATE BOARD
PI SURP SET UM1 REGS AND POINTERS
*
*Put in initial pieces both in SC and in blocks 0 or 1
LISU PLOC
LISL H'0'
LI H'FF' Full double row of pieces
LR I,A First byte of ACTIVE
LI H'F0' 1 row only
LR I,A Second byte of active
CLR
LR I,A Part of board with no active pieces
LR I,A Part of board with no active pieces
LR I,A Part of board with no passive pieces
LR I,A Part of board with no passive pieces
LI H'F' 1 row only (in second half of byte)
LR I,A byte of PASSIVE
LI H'FF' Full double row of pieces
LR I,A Last byte with Passive pieces
LISU KLOC
LISL 0
CLR
LR I,A 4 king bytes next (all empty)
LR I,A
LR I,A
LR I,A
LI H'F0' The 4 bits for pieces that can move RF
LR I,A The MOVE byte
LIS H'4' BYTE # 1 RF normal move with no piece debit
LR I,A
LI H'80' Set score at -128 (lose, unless move is found)
LR I,A
CLR With position advantage of 0
LR I,A
* LR DC,H This was set earlier
* PI SCRD Store pieces in correct RAM pos.
* LR DC,H
CLR Should put black at bottom
COM Should put red at bottom
DCI COL0
ST
PI MEN
PI POPS
PK
* Code to read the internal representation of the board and to put the
* required pieces into the board image.
*
MEN LISU O'3' Start with pieces
LIS H'1' 1 for red pieces (shown first always)
LR 4,A To specify piece color (1 red, 0 black, -1 king)
LR A,COL0
LR 7,A
NS 7 Set status
LISL O'7' Decrement if black is active and shift right
BZ MEN1 Black is active (Appears at bottom of screen)
LISL O'0' Red is active, increment and shift left
MEN1 LIS H'3'
LR 1,A To count bytes
MEN2 LR K,P
LIS H'7'
LR 2,A To count bits
DCI TAB1 STARTING ADDRESS FOR BYTE LOCATION
LR A,1 This byte number
SL 1 Locations occupy 2 bytes each
ADC
LM Get the location
LR QU,A and save it in Q
LM
LR QL,A
LR A,7
NS 7
BZ MEN5 Black is active
LR A,I Increment if red is active
BR MEN4
MEN3 LR A,3
SL 1 and shift left
MEN4 LR 3,A
NI H'80' (done this way for symetry, BC would work)
BZ MEN9
BR MEN8
MEN5 LR A,D Decrement if black is active
BR MEN7
MEN6 LR A,3
SR 1 and shift right
MEN7 LR 3,A
NI H'1'
BZ MEN9
MEN8 DCI TAB2 Relative-locations-of-squares table
LR A,2 This square
ADC
LM Get square displacement
LR DC,Q Recall the location for the input byte
ADC This is the square position
LR A,4 Identify type of piece
NS 4
BM PUTK To put down a king
LIS H'4' Prepare for a piece
LR 5,A To count lines
LI H'20' Skip the first 4 lines (4*8)
ADC
XDC
DCI BLKP Anticipate a black piece
BZ PUTL A black piece (status bit still ok)
DCI REDP No, it's a red piece
BR PUTL
PUTK LIS H'2' Only 3 lines for a crown
LR 5,A
LIS H'8' To skip 1 line
ADC
XDC
DCI KING
PUTL LM Put loop
XDC
ST
LIS H'7' To next line on screen (less increment)
ADC
XDC
DS 5
BP PUTL Loop
MEN9 DS 2
BM ME10
LR A,7
NS 7
BZ MEN6 Black active case
BR MEN3 Red active case
ME10 DS 1
BP MEN2 For the next input byte
LR A,4
NS 4
BM BDEX Exit from board routine
DS 4
BP MEN1 Go round again for black pieces
LISU H'4' Get set for kings
LR A,7
NS 7
LISL H'3' Decrementing case
BZ MEN1
LISL H'0' Incrementing case
BR MEN1
BDEX PK
*
***********************************************************************
*
* BORD GENERATES BOARD IMAGE
*
************************************************************************
*
BORD LR K,P
PI PUSH
LI H'FF'
LR 3,A REG3=FF
DCI OBJ0 BRD1 START ADDRESS
LIS H'2' FLAG FOR BORD
LR 4,A SET REG 4 = 2
LIS H'6'
BRD4 LR 0,A REG0 = 6 ROWS
BRD3 LIS H'A'
LR 1,A REG 1 = 10 LINE/ROW
BRD2 LIS H'4'
LR 2,A REG2=SQ PAIRS/ROW
BRD1 LR A,3
ST STORE IN BRD
COM
ST NEXT IS COMPL. OF FIRST
DS 2
BNZ BRD1 MORE FOR THIS ROW
DS 1 NO, ALL LINE DONE
BNZ BRD2
LR A,3 DONE A TIMES YET
COM
LR 3,A
DS 0 DEC ROW COUNT
BNZ BRD3 ALL ROWS DONE?
DS 4
BZ BRD5 BOTH OBJECTS DONE?
DCI OBJ1 NO,GET BORD2 ADDRS.
LIS H'2'
BR BRD4 REG0=2
BRD5 PI POPS
PK
***********************************************************************
*
* SURP SETS UM1 REGS & PTRS
*
***********************************************************************
SURP LR K,P
PI PUSH
DCI H'800' UM1 REG START
XDC TUCK IT AWAY
DCI INIT INIT TABLE POINTER
LIS H'6'
LR 0,A
SRP1 LM READ INIT TABLE
XDC
ST PUT IN UM1
XDC PT. BACK TO INIT
LM READ TABLE
XDC
ST
DS 0 REG 0 = COUNTER 6
BZ SRP2
LIS H'E'
ADC
XDC
BR SRP1 CONTINUE
SRP2 LI H'1E' DO LAST TWO ENTRIES
ADC
XDC
LM GET IT FROM INIT TAB
XDC
ST PUT IT UM1
XDC
LM GET IT FROM
XDC
ST
*
* SET UPI PTRS
*
DCI UDIT
LR Q,DC
DCI UPI
LIS H'2'
ST
ST
LR A,QU
ST
LR A,QL
ST ODD
LR A,QU
ST
LR A,QL
ST
PI POPS
PK
*
* Subroutine to move data from RAM to S O'30' thru O'47' with the data for
* S O'30' thru O'43' coming from the current block. Data for O '44' thru
* O'47' is from the previous block, with some items deleted.
*
RASC LR K,P Save return address
PI PUSH
LISU PLOC SC buffer with Active and Passive
LISL 0
LIS H'8'
LR 0,A
PI RASL
LISU KLOC SC buffer with Kings
LISL 0
LIS H'4'
LR 0,A
PI RASL
LI H'F1' Rest of data from earlier block
ADC
CLR Zero the MOVE byte
LR I,A
LM
NI H'E0' Save Piece debit only
LR I,A
LM
LR I,A Keep both SCORE bytes
LM
LR I,A
PI POPS
PK
*
RASL LR K,P
RAS2 LM
LR I,A
DS 0
BNZ RAS2
PK
*
*Subroutine to move 16 bytes from SC O'30' thru O'47' to RAM direct.
SCRD LR K,P
PI PUSH
LISU PLOC
LISL 0
LIS H'8'
LR 0,A
PI SCRL
LISU KLOC
LISL 0
LIS H'8'
LR 0,A
PI SCRL
PI POPS
PK
*
*Subroutine to move 16 bytes from SC O'30' thru O'47' to RAM, reversing
*ACTIVE and PASSIVE and deleting some items
SCRA LR K,P
PI PUSH
LISU PLOC
LISL 4
LIS H'4'
LR 0,A
PI SCRL
LISL 0
LIS H'4'
LR 0,A
PI SCRL
LISU KLOC
LISL 0
LIS H'4'
LR 0,A
PI SCRL
LR A,I To index only
CLR Zero MOVE byte
ST
LR A,I
NI H'E0' Save piece debit only
LR A,I
ST Save both SCORE bytes
LR A,I
ST
PI POPS
PK
*
SCRL LR K,P
SCR3 LR A,I
ST
DS 0
BNZ SCR3
PK
*
*To compute 4 bytes which show the empty squares on the board and store
*them in O'51' thru O'54' with O'50' and O'55' set to zero as guards.
*Note especially that the EMPTY locations are displaced relative to ACTIVE.
EMPTY LR K,P
LISU ELOC
LISL 0
CLR
LR S,A Make sure guard byte is empty
LISU PLOC Start with ACTIVE
LIS H'4'
LR 0,A
BR EMP3
EMP2 LR A,IS
AI H'30' Actually subtracting 16
LR IS,A
EMP3 LR A,S
LR 1,A
LR A,IS
AI 4
LR IS,A
LR A,S
AS 1
LR 1,A
LR A,IS
AI H'D' Add 13 to get to the correct EMPTY location
LR IS,A
LR A,1
COM Reverse 1's and 0's
LR S,A
DS 0
BNZ EMP2
CLR
LR S,A Upper guard byte
PK
*
*Subroutine to count bits in 0 and return count in A
*Uses registers 0 and 1
CAQ LR K,P
CLR
LR 1,A
LR A,0
BR CAQ3
CAQ2 DS 1
AI H'FF'
NS 0
LR 0,A
CAQ3 BNZ CAQ2
LR A,1
COM
INC Make it into a true positive number
PK
*
*Subroutine to multiply 2 positive binary numbers (the smaller in SC 1 and
*the larger in SC 2) by Russian multiplication. SC 0 is used to accumulate
*the product. This code may be used at only one place and can probably be
*written in line at that place with some saving of space.
*
MPYR LR K,P
CLR
LR 0,A To accumulate the product
LR A,1
MPY1 NI H'1' Is the rightmost bit a 1?
BZ MPY2 No
LR A,2
AS 0
LR 0,A
MPY2 LR A,2
SL 1
LR 2,A
LR A,1
SR 1
LR 1,A
BNZ MPY1 Product is not complete
PK
*MAP Code to convert joystick reading into cursor position on board.
*Cursor's position on the board image is limited to the playing squares.
*When the joystick is moved the cursor jumps from playing square to
*playing square, always landing on that square that is nearest to the
*indicated joystick position.
*
*Interrogates JOYI twice to get X and Y readings of joystick position.
*Returns byte in 3 (with one bit on for square) and byte number in 4 and
*moves cursor from old position on board image to new position.
*Uses reg 0, 1, 2, 3, 4, H, Q, and DC.
MAP LR K,P
PI PUSH
LIS H'01' GET X
LR HU,A
NOP
NOP
NOP
NOP
DI
DCI COM
LI H'65'
ST
DCI CMRG
ST
LI H'30'
PI WAIT
PI JOYI
LR 0,A
NOP
NOP
NOP
NOP
PI MAPA
LR A,0
LR 1,A
CLR
LR HU,A
NOP
NOP
NOP
NOP
PI JOYI
LR 0,A
NOP
NOP
NOP
NOP
*This code for compilers that accept : and .
LI INHR: Set INT vector in SMI
OUTS H'C'
LI INHR.
*This code for compilers that do not accept : and .
* DCI INHR
* LR Q,DC
* LR A,QU
* OUTS H'C'
* LR A,QL
*End of substitution
OUTS H'D'
LIS H'1'
DCI COM
LI BCMD
ST
DCI CMRG
ST
EI
NOP
NOP
NOP
NOP
PI MAPA
LR A,0
LR 2,A
AS 1
LR 3,A Unnormalized sum in 3
LIS H'8'
LR 0,A
LR A,3
MAP2 DS 0
AI H'F9' Sub 7
BP MAP2
LR A,0
LR 3,A Sum into 3, range 0 thru 6
LR A,1
COM
AI D'25'
AS 2
LR 4,A Unnormalized difference in 4
LIS H'9' Need 8 catagories for the difference
LR 0,A
LR A,4
MAP3 DS 0
AI H'FD' Sub 3
BP MAP3
LR A,0
LR 4,A Difference into 4, range 0 thru 7
COM
INC
AS 3
INC
LR 1,A Normalized X value
LR A,4
AS 3
INC
SR 1
LR 2,A Normalized Y value
SR 1
LR 4,A The byte number left in 4
LR A,1
SR 1
INC
LR 3,A
LIS H'8'
BR MAP5
MAP4 SR 1
MAP5 DS 3
BNZ MAP4
LR A,1
NI H'1'
BNZ MAP6
LR A,3
SR 4
LR 3,A
MAP6 NOP Byte with bit on left in 3
LR A,1
SR 1
LR 1,A
LR A,2
NI H'1'
BZ MAP7
LR A,1
AI H'4'
LR 1,A This is now the offset in the byte
MAP7 NOP
DCI JSAV
LR Q,DC
CM
BZ MAPX No change in position so exit
*Now we want to remove the old cursor and write the new
PI MAPS Write new cursor
DCI JSAV
LR Q,DC
LM
LR 0,A
LR A,1
LR DC,Q
ST Save new value
LR A,0
LR 1,A Get ready to delete old cursor
LR Q,DC
LM
LR 0,A
LR A,4
LR DC,Q
ST
LR A,0
LR 4,A
CI H'07'
BM MAPX No old cursor to remove
PI MAPS
MAPX PI POPS
PK
*Subroutine to complement cursor (to remove old one or write new one)
MAPS LR K,P
DCI TAB1
LR A,4
SL 1
ADC
LM
LR QU,A
LM
LR QL,A
LIS H'4'
LR 5,A
DCI TAB2
LR A,1
ADC
LM
LR DC,Q
ADC
XDC
DCI POIN
PUTP LM
XDC
LR Q,DC
XM Compliment POIN
LR DC,Q
ST
LIS H'7'
ADC
XDC
DS 5
BP PUTP
PK
*
*Subroutine to reduce range and invert if necessary
MAPA LR K,P
LR A,0
SR 1
SR 1
SR 1
LR 0,A
LR A,7 Check color
NS 7
BNZ MAPB Do we need to invert?
LR A,0
COM
AI D'25'
LR 0,A
MAPB PK
*
*
*
ORG H'17C0'
* INHR INTERRUPT HANDLER
*
* WILL STORE ENVIRONMENT BEFORE CALLING UDAT
* AND RESTORE BEFORE GOING BACK'
*
INHR LR 6,A SAVE ACC
LR A,IS
LISU O'6'
LISL O'0'
LR I,A SAVE A IN REG24
LR A,QU
LR I,A SAVE QU IN REG25
LR A,QL
LR I,A SAVE QL IN REG26
LR A,J
LR I,A SAV IN REG27
XDC
LR Q,DC GET DC
DCI H'0FB0' GET FREE RAM ADDR.
LR A,QU SAVE ORIGINAL DC1
ST
LR A,QL
ST
XDC
LR Q,DC
XDC
LR A,KU
ST
LR A,KL
ST SAVE KL
LR A,10 UPPER H
ST SAVE IT
LR A,11
ST SAVE H
LR J,W
LR A,J
ST SAVE W
LR K,P
LR A,KU
ST SAVE PCU
LR A,KL
ST SAVE PCL
LR A,QU SAVE DC0 ORIGINAL
ST
LR A,QL
ST
PI UDAT UPTE DISPLAY
*
* RESTORE ALL REGISTERS
*
DCI H'0FB0'
LM
LR QU,A GET DC1
LM
LR QL,A
XDC
LR DC,Q RESTORE DC1
XDC
LIS H'2'
ADC BYPASS 'K' SAVED AREA
LM GET HU
LR HU,A RESTORE HU
LM
LR HL,A RESTORE HL
LM GET W
LR J,A
LR W,J RESTORE IT
LM GET PC1 HO
LR KU,A
LM
LR KL,A
LR P,K RESTORE PC1
LM
LR QU,A
LM
LR QL,A
DCI H'FB2' PT TO K
LM GET KU
LR KU,A
LM
LR KL,A RESTORE K
LR DC,Q RESTORE DC0
*
* NOW RESTORE J,Q,A FROM SCRATCH PAD
*
LISU O'6'
LISL O'3'
LR A,D GET J
LR J,A
LR A,D GET QL
LR QL,A
LR A,D
LR QU,A RESTORE QU
LR A,D GET ISAR
LR IS,A RESTORE ISAR
LR A,6 RESTORE A
EI INT. ENABLE
POP
* DISPALY YOU MOVE FIRST?
* Y OR N
*
*
YMF DC H'0513' Y0
DC H'0300' U-
DC H'2913' MO
DC H'2F0B' VE
DC H'00' -
DC H'1D' F
DC H'0109' IR
DC H'2107' ST
DC H'00' -
DC H'35' ?
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'0500' Y-
DC H'1309' OR
DC H'00' -
DC H'2B' N
* INIT DATA
INIT DC H'30' OBJ0 L.O.RP
DC H'10' OBJ1 L.O. RP
DC H'8C' OBJ0 H.O.RP+COLOR
DC H'8F' OBJ1 H.O.RP
DC H'48' OBJ0 DELTA X ---
DC H'48' OBJ1 DELTA X---
TY0 DC H'3C' OBJ0 DELTA Y ----
DC H'14' OBJ1 DELTA Y ---
DC H'0D' OBJ0-X-CO
DC H'0D' OBJ1 X-CO
DC H'47' OBJ0 Y-VALUE L.O.A
DC H'BE' OBJ1 Y-VALUE L.O.A
DC H'00' OBJ0 Y-VALUE H.0 &X-ORDER
DC H'01' OBJ1- Y-VAL H.O.$X-ORDER
*A DUMMY LINE TO FIX AN ASSEMBLY ERROR
UDIT DC H'30'
DC H'10'
DC H'8C'
DC H'8F'
DC H'3C'
DC H'14'
TAB1 DC H'0F10' BYTE 3
DC H'0D70' BYTE 2
DC H'0CD0' BYTE 1
DC H'0C30' BYTE 0
TAB2 DC D'86' RELATIVE SQUARE POSITION TABLE
DC D'84'
DC D'82'
DC D'80'
DC D'07'
DC D'05'
DC D'03'
DC D'01'
KING DC B'01011010' KING'S CROWN
DC B'00111100'
DC B'00011000'
REDP DC B'00111100' RED PIECE
DC B'01111110'
DC B'01111110'
DC B'01111110'
DC B'00111100'
BLKP DC B'00111100' BLACK PIECE
DC B'01000010'
DC B'01000010'
DC B'01000010'
DC B'00111100'
POIN DC B'00001100'
DC B'00000110'
DC B'00000011'
DC B'00000001'
*******************************************************************
*
* SKILL LEVEL TEXT TABLE
*
********************************************************************
SKL DC H'3119' CH
DC H'1313' OO
DC H'210B' SE
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'150B' KE
DC H'0500' Y-
DC H'00' -
DC H'00' -
DC H'0713' TO
DC H'2900' M-
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'07' T
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DICK DC H'1F01' DI
DC H'3115' CK
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'1F' D
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
HARY DC H'1911' HA
DC H'0909' RR
DC H'0500' Y-
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'19' H
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
*
* 64 BYTES TABLE FOR
* CHOOSE SKILL LEVEL
* INPUT MODE J/K
*
INJK DC H'012B' IN
DC H'2503' PU
DC H'0700' T-
DC H'00' -
DC H'00' -
DC H'2913' MO
DC H'1F0B' DE
DC H'00' -
DC H'35' ?
DC H'00' -
DC H'00' -
KBRD DC H'150B' KE
DC H'052D' YB
DC H'1311' OA
DC H'091F' RD
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'15' K
DC H'00' -
DC H'00' -
DC H'1713' JO
DC H'0521' YS
DC H'0701' TI
DC H'3115' CK
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'17' J
DC H'00' -
DC H'00' -
*
* END OF zINPUT MGDE TABLE
* 48 BYTES
*Initial moves for black
BLKM DC H'4' Number of valid entries
DC B'11110000' A byte
DC H'0100' with byte info (byte 1 RFN moves)
DC B'11100000'
DC H'0101'
DC H'00'
*Initial moves for red
REDM DC H'4' Number of valid entries
DC B'00000111'
DC H'0210'
DC B'00001111'
DC H'0211'
DC H'00'
*
ORG H'1980'
*
JOYI LR K,P
LR A,HU SAVE POT# IN SP20
LISU 2
LISL 0
LR I,A
LIS 1 SET PORT 0
JOY8 DS HU
BM JOY7
SL 1
BR JOY8
JOY7 OUTS 0
LIS 3 SAVE YCUR+3 INTO SP21
DCI YCUR
AM
LR S,A
DCI YINT SET YINT TO YCUR+3
ST
LI JOY1: SET SMI VECTOR
OUTS H'C'
LI JOY1.
OUTS H'D'
LIS 1 ENABLE SMI
OUTS H'E'
EI ENABLE CPU INT
LIS INT SET INT BIT IN PCOM
DCI PCOM
LR H,DC SAVE ADDRESS
XM
LR DC,H RECOVER ADDRESS
ST
DCI COM AND IN COM REG
ST
BR * WAIT
*
YCUR EQU H'08F8'
YINT EQU H'08F0'
PCOM EQU CMRG
PRIS EQU H'0FDE'
FRZ EQU H'2'
XFRZ EQU H'08F8'
YFRZ EQU H'08F9'
INT EQU H'8'
JOY1 LI H'80' ENABLE JOYSTICKS
DCI PRIS DCO TO PORT 1 SAVE
LR H,DC SAVE IN H REGISTER
LM GET CURRENT SAVED VALUE
OI H'80' JOYSTICK BIT ON
LR DC,H RECOVER ADDRESS
ST RESET SAVE VALUE
OUTS 1
LI JOY2. SET SMI VECTOR
OUTS H'D'
LIS H'A' SET FRZ AND CLEAR INT BITS
DCI PCOM
LR Q,DC
XM
LR DC,Q
ST IN PCOM
DCI COM
ST AND IN COM REG
EI ENABLE CPU INT
BR * WAIT
JOY2 LR DC,H RECOVER PRIS ADDRESS
LM RECOVER VALUE
NI H'7F' JOYSTICKS OFF
LR DC,H RECOVER ADDRESS
ST RESET VALUE
OUTS 1 AND DISABLE JOYSTICKS AT UM1
CLR CLEAR ACC
OUTS H'E' DISABLE SMI
LR QU,A ZERO Q
LR QL,A
LR HU,A SET H=NUMBER OF DOTS/LINE
LI 228
LR HL,A
LR A,S COMPUTE NUMBER OF LINES
COM
INC
DCI YFRZ
AM
LR S,A INTO SP21
PI AD MULTIPLY- RESULT INTO Q
DS S
BNZ *-4
DCI XFRZ ADD XFRZ
LM
LR HL,A
PI AD
LI 38 SUBTRACT 38
LR HL,A
PI SU
LR A,QU SAVE RESULT IN SP21,22
LR I,A
LR A,QL
LR D,A
LR A,D INDEX INTO THE MAX-MIN VALUES
LR A,I FOR THE POT
SL 1
SL 1
DCI JOYT
ADC
LM LOAD MAXIMUM INTO H
LR HU,A
LM
LR HL,A
PI SU IS MAX<=READING?
BNC JOY3
LI -2 YES- RESET MAX
ADC
LR A,I
ST
LR A,D
ST
BR JOY6 AND RETURN MAX
JOY3 LR A,I SET READING INTO Q
LR QU,A
LR A,D
LR QL,A
LM LOAD MINIMUM INTO H
LR HU,A
LM
LR HL,A
PI SU IS MIN<=READING?
BC JOY4
LI -2 NO- RESET MIN
ADC
LR A,I
ST
LR A,D
ST
CLR AND RETURN 0
BR JOYB
JOY4 LR A,QU SAVE READING-MIN IN SP21,22
LR I,A
LR A,QL
LR D,A
LI -4 LOAD MAX INTO Q
ADC
LM
LR QU,A
LM
LR QL,A
PI AD COMPUTE MAX-MIN
DCI H'535'
LR H,DC
PI SU IS 535<=RANGE?
BC *+5
LIS 8 NO- SET FACTOR=8
BR JOY5
LIS H'1'
LR HU,A
LIS H'A'
LR HL,A
PI SU IS 801<=RANGE?
BC *+5
LIS 6 NO- SET FACTOR=6
BR JOY5
LIS H'1'
LR HU,A
LIS H'C'
LR HL,A
PI SU IS 1069<=RANGE?
BC *+5
LIS 4 NO- SET FACTOR=4
BR JOY5
DCI 1601-1069
LR H,DC
PI SU IS 1601<=RANGE?
LIS 3 NO- SET FACTOR=3
BNC JOY5
LIS 2 YES- SET FACTOR=2
JOY5 LISL 0 SAVE FACTOR IN SP20
LR I,A
CLR ZERO Q
LR QU,A
LR QL,A
LR A,I SET OFFSET READING IN H
LR HU,A
LR A,D
LR HL,A
LISL 0
PI AD MULTIPLY BY FACTOR
DS S
BNZ *-4
LR A,QU IS RESULT<256*16?
SR 4
BNZ JOY6 NO- GO RETURN 199
LR A,QU DIVIDE BY 16
SL 4
LR S,A
LR A,QL
SR 4
XS S
CI 199 IS RESULT<=199?
BC *+4
JOY6 LI 199 NO- SET IT TO 199
JOYB LR S,A SAVE IT IN SP21
LIS FRZ CLEAR FRZ BIT
DCI PCOM IN PCOM
LR H,DC SAVE ADDRESS
XM
LR DC,H RECOVER SAME
ST
DCI COM AND IN COM REG
ST
LR A,D RETURN WITH VALUE IN AC
PK
********************
* SUBTRACT H FROM Q
* CARRY SET ON Q+COM(H)+1=10000+(Q-H)
* CARRY THUS SET IFF H<=Q
SU LR A,HU
COM
LR HU,A
LR A,HL
COM COMPLEMENT...
INC
LR HL,A
LR A,HU
LNK
LR HU,A AND INCREMENT H
LR A,QU PREPARE FOR RETURN WITH QU IN AC
BC AD1 IF CARRY, H=0, SO GO RETURN
* WITH CARRY SET
*
* ADD H TO Q
AD LR A,QL
AS HL
LR QL,A
LR A,QU
LNK
BC AD0 IF CARRY, QU+LNK=100, SO GO LOAD WITH
AS HU HU AND RETURN WITH CARRY SET
LR QU,A ADD TO Q
AD1 POP
AD0 LR A,HU
LR QU,A
POP
END
*
* FKT GMEN RFJN LFJN STMV
*
*Subroutine to limit pieces to KINGS depending on direction and color
FKT LR K,P
CLR
AS 7
BR FK1
BKT LR A,7 Test sides for backward move
COM
FK1 BZ FK2 NORMAL pieces can move
LISU KLOC KINGS only can move
LR A,S
NS 3
LR 3,A
BZ FK3 No RF OR LF moves from this byte
FK2 LR A,3
NS 3 To set status
FK3 PK
*
FJET LR K,P
LIS H'1'
BR BJE2
BJET LI H'FF'
BJE2 AS 4
AI ISE
LR IS,A
LR A,S
PK
*
*Subroutine to get byte of ACTIVE pieces
GMEN LR K,P
LR A,4
AI ISA Start of active area
LR IS,A
LR 5,A Save it here temporarily
LR A,6
CI H'7' Is this an attempted continuation?
BZ GME2 Yes, 3 is already set
CI H'1' Maybe back up to test for forked continuation
BZ GME2
LR A,S
LR 3,A
GME2 PK
*
*Subroutine used both by RFJ and RFN
RFJN LR K,P
LR A,I
SL 4
LR 0,A
LR A,S
SR 4
SR 1
AS 0
NS 3
LR 3,A The RFJ or RJ byte
PK
*
*Subroutine used both by LFJ and LFN
LFJN LR K,P
LR A,I
SL 4
SL 1
LR 0,A
LR A,S
SR 4
AS 0
NS 3
LR 3,A The LFJ or LFN byte
PK
*
*Subroutine used both by LBJ and LBN
LBJN LR K,P
LR A,D
SL 4
LR 0,A
LR A,S
SR 4
SR 1
AS 0
NS 3
LR 3,A
PK
*
*Subroutine used both by RBJ and RBN
RBJN LR K,P
LR A,D
SL 4
SL 1
LR 0,A
LR A,S
SR 4
AS 0
NS 3
LR 3,A
PK
*Subroutine to add to MOBILITY, and to store MOVE and FLAG bytes if necessary
STMV LR K,P
LISU KLOC
LISL 4 To MOVE byte
LR A,3 GET newly computed MOVE byte
LR 0,A
PI CAQ Count its bits
AS 2 Add earlier counts
LR 2,A and store
LR A,11
SR 4
CI H'01' Is this the player's board
BNZ STM3
DCI PLMV Player's possible moves are stored separately
LM
INC
INC Entries take two bytes
DCI PLMV
ST
AI H'FE' Subtract 2
ADC
BR STM4
STM3 LR A,S Has a move byte been stored?
NS S To set status byte
BNZ STM2 One is already stored
LR DC,H Get back in step (may not be necessary)
LIS H'C' To get to MOVE byte
ADC
STM4 LR A,3
ST Store MOVE byte in RAM
LR I,A Also put it in SC record as a flag
LR A,4 Get the byte pointer
SL 1
SL 1
AS 5
ST Put this into RAM
LR DC,H May be necessary
STM2 PK
*Subroutine to clear space for listing player's possible moves temporarily
CLPM LR K,P
XDC
DCI PLMV This space is also used by TREE routine
LIS H'F'
LR 0,A
CLR
ST
DS 0
BP *-2
XDC
PK
* NEXT FIND RFJ LFJ RBJ LBJ
*
NEXT CLR
LR 6,A Set for normal back up
LR DC,H
LIS H'D' Get to byte number info
ADC
LR A,11 Check for multiple jump condition
SR 4
AI H'FD' 1 for start offset, 2 ply's Mobs. not saved
BM NEX2 Can not be a continuation
XDC Save location
DCI MOBS
ADC
LM
NI H'7' Is flag set?
XDC
BZ NEX2 No multiple jump
*The moving piece byte and byte number is stored in the next earlier block
XDC
LR DC,H
LI H'FC' Back up to get info
ADC
LM
LR 3,A The byte with 1 bit on
LM
LR 4,A The byte number
XDC Now back again to the current block
LIS H'1' The signal read by GMEN
LR 6,A Overwrite previously set value
NEX2 LM Get identifying data
LR 0,A Save temporarily
NI H'F' Leave J bit and other data off
CI H'F' Is this the last move byte?
BZ NEX5 Yes
LR A,0
INC To next direction
LR 0,A
SR 1
SR 1
NI 3
LR 4,A Save byte number
LR A,0 Now get the direction
NI 3 Separate out desired data
LR 5,A And save (it will be a 1, 2, or 3)
LR A,0
NI H'10' Check jump bit
BNZ NEX4 A jump move
LR A,5
NS 5
BZ NEX3
JMP RBN0 A normal move, decide on 1, 2, or 3 later
NEX3 JMP RFN It was 0
NEX5 JMP AFT
NEX4 LR A,5
NS 5
BZ RFJ It was a 0
CI H'2' Which direction, 1, 2, or 3?
BM LBJ It was a 3
BNZ LFJ It was a 1
BR RBJ It was a 2
*We enter here on going forward
FIND LISU PLOC
LISL 0 Start with byte 0
CLR
LR 4,A Used to distinguish byte
LR 2,A Used to accumulate mobility count by STMV
LI H'FF'
LR 6,A So all moves will be found
RFJ PI GMEN
PI FKT Are there forward moving pieces?
PI FJET Are jump moves in this direction posible?
SR 1
NI H'77' Save 6 particular bits only
NS 3
LR 3,A Only pieces that have place to land
LR A,4 Get byte number
AI ISP Start of passive area
LR IS,A
PI RFJN This returns the RFJ byte in 3 and sets STATUS
BZ LFJ
LI H'10' The RFJ direction and J indicator
LR 5,A
PI STMV Store MOVE and FLAG if MOVE found
BR JUMF
LFJ PI GMEN
PI FKT
PI FJET Are jump moves in this direction posible?
SL 1
NI H'EE' Save 6 particular bits only
NS 3
LR 3,A Only pieces that have a place to land
LR A,4 Get byte number
AI ISP Start of passive area
LR IS,A
PI LFJN This returns the LFJ byte in 3
BZ RBJ
LI H'11' The LFJ direction and J indicator
LR 5,A
PI STMV
BR JUMF
RBJ0 LR A,5
CI H'2' Which direction, 1, 2, or 3?
BM LBJ It was a 3
BNZ LFJ It was a 1
RBJ PI GMEN
PI BKT
PI BJET
SR 1
NI H'77' Save 6 particular bits only
NS 3
LR 3,A
LR A,4 Get byte number
AI ISP Start of passive area
LR IS,A
PI RBJN This returns the RBJ byte in 3
BZ LBJ
LI H'12' The RBJ direction and J indicator
LR 5,A
PI STMV
BR JUMF
LBJ PI GMEN
PI BKT
PI BJET
SL 1
NI H'EE' Save 6 particular bits only
NS 3
LR 3,A
LR A,4 Get byte number
AI ISP Start of passive area
LR IS,A
PI LBJN This returns the RBJ byte in 3
BZ JUMT
LI H'13' The RBJ direction and J indicator
LR 5,A
PI STMV
JUMF LR A,11 Where are we?
SR 4 To get the ply
CI H'1' Remember offset
BNZ JUMD
JMP PMRT Check players move for validity
JUMD CI H'F' Are we out of space? (next block contains MOBS)
BZ RFN To compute non-jump mobility and stop anyway
LR DC,H
JMP SELE
* JUMT AFTC
*
*No move found from this byte so see if there are more bytes
JUMT LR A,6
*Are we backing up and then trying to find yet another continuation?
CI H'1' Are we backing up to a possible fork
BZ AFTC Yes so something special is required
CI H'7' Were we trying to find a continuation
BNZ JUMM No
LR DC,H There was no continuation
LI H'F0' Back up
ADC
LR H,DC
JMP DOUX This changes the color and proceeds
JUMM LR A,4
INC
NI H'3'
LR 4,A
BNZ RFJ Go round again for next byte
LR A,6
XI H'FF'
CLR
LR 4,A Prepare to start over on the first byte
BZ RFN Maybe there are normal moves
JMP AFT A jump was demanded so back up
*We compare the score with that 2 blocks earlier and back it up if greater
*and then back to this level in any case
AFTC LR DC,H
LIS H'E'
ADC
XDC
LR DC,H
LI H'E0'
ADC
LR H,DC
LIS H'E'
ADC
XDC
LM
LR 0,A Save it
XDC
CM
BM AFT2 Score should be backed
BZ AFT3 Further testing indicated
AFT5 JMP SELE
AFT2 XDC
LM
LR 1,A
BR AFT4
AFT3 XDC
LM
LR 1,A
XDC
CM
BP AFT5 Do not back score
AFT4 XDC
LI H'FE'
ADC
LR A,0
ST
LR A,1
ST
BR AFT5
* AFT MAKE OKMV PMRT
*
*No moves found so time to back up
AFT LR DC,H
LIS H'E' Get to SCORE
ADC
LM
LR 0,A The current material advantage term
LM
LR 6,A The current positional term
LR A,11 Where are we?
SR 4
CI H'2'
BZ MAKE Time to report move
CI H'3' Room to alpha-beta prune?
BP AFTX No
LR DC,H
LI H'EE' The score for 2 boards earlier
ADC
JMP EV4A
AFTX JMP EVA5
*
*Prepare for analysis of player's reply
MAKE DCI TREE Get to players board
LR H,DC
XDC Now clear space for possible players moves
DCI PLMV This space is also used by TREE routine
LIS H'F'
LR 0,A
CLR
ST
DS 0
BP *-2
XDC
PI RASC Put board into SC
JMP FIND
*Subroutine to save players possible moves
SVPM LR K,P
XDC So we can get back
LR A,5
NI H'10'
DCI PLMF Players jump move flag
ST
LR A,4
SL 1
SL 1
AS 5
NI H'F' Save only last 4 bits
DCI PLMV This area may be overwritten by tree info.
ADC
LR A,3
ST
XDC
PK
PMRT NOP Player's possible moves have been listed
*We are ready to display the new board
**** DISPLAY CODE GOES IN HERE
*We are ready to verify players move
OKIT DCI PLMV Location where players move began
**** INIT JOYSTICK and wait for players indication that he has picked
***piece to move then go to OKPI and then to OKMV
* RFN LFN RBN LBN NORT NORF NOR2 NOR3 NOR4
*
RFN PI GMEN
PI FKT
BZ RBN
LR A,4 Get byte number
AI ISE Start of empty region
LR IS,A
PI RFJN
BZ LFN
CLR
LR 5,A
PI STMV
LR A,6
XI H'FF'
BNZ NORF
LFN PI GMEN
PI FKT
BZ RBN
LR A,4 Get byte number
AI ISE Start of empty region
LR IS,A
PI LFJN
BZ RBN
LIS H'1'
LR 5,A
PI STMV
LR A,6
XI H'FF'
BNZ NORF
BR RBN
RBN0 LR A,5
CI H'2' Which direction, 1, 2, or 3?
BM LBN It was a 3
BNZ LFN It was a 1
RBN PI GMEN
PI BKT
BZ NORT
LR A,4 Get byte number
AI ISE Start of empty region
LR IS,A
PI RBJN
BZ NORT
LIS H'2'
LR 5,A
PI STMV
LR A,6
XI H'FF'
BNZ NORF
LBN PI GMEN
PI BKT
BZ NORT
LR A,4 Get byte number
AI ISE Start of empty region
LR IS,A
PI LBJN
BZ NORT
LIS H'3'
LR 5,A
PI STMV
LR A,6
XI H'FF'
BZ NORT
NORF JMP SELE
*We get here if we want to compute mobility and also if no moves found
NORT LR A,4
INC
NI H'3'
LR 4,A
BNZ RFN Go round again for next byte
LR A,2 Get mobility count
NS 2
BNZ NOR1
JMP AFT Woops! no move found
NOR1 LR A,11 Where are we?
SR 4 Get Ply number
AI H'FF'
LR 3,A
BNZ NOR2
JMP PMRT Ckeck players move for validity
NOR2 XDC
DCI PLY0 Neg. of ply test value stored here
LM
XDC
AS 3
BM NOR4 Go on for sure
AI H'FE'
BP NOR3 Time to evaluate for sure
LI H'F5' Decision based on previous move
ADC
LM
NI H'10' Test jump flag
LR DC,H
BNZ NOR4 Go on if previous move was a jump
NOR3 JMP EVAL
NOR4 LR A,3
NOR5 AI H'FD' To save space so MOBS will not overflow
BM NOR7 Don't save mobility for early plys
DCI MOBS
ADC
LR A,2
CI H'F' Limit mobility to 15 so it will pack
BP NOR6
LIS H'F'
NOR6 SL 4 Reserve right half for Multiple jump flags
ST Save mobility in MOBS space indexed by ply
NOR7 LR DC,H Get back in step
JMP SELE
* SELECT SELE
*
*SELECT branches to NEXT if MOVE is empty, or it extracts the rightmost
*bit from the MOVE byte in RAM, storing the extracted bit in SC 6, puts the
*FLAG byte in SC 7, the byte number in 4, and the J and direction bits in 5.
*and proceeds to make the selected move.
SELE LR DC,H Load DC with starting location for current ply
PI RASC Get board data into Scratchpad
SEL2 LR DC,H
LIS H'C' To get MOVE byte
ADC
LM
LR 0,A Save it temporarily
NS 0 To set status byte
BNZ SEL3
JMP NEXT To get next MOVE byte
SEL3 LI H'FF'
ADC Get back to move byte
LR A,0
AI H'FF' Really subtracting 1
NS 0 Remove right-most on-bit
ST Put remaining bits back (and index)
XS 0 This gets the extracted bit
LR 6,A Save it in 6
**** A record of the serial number of this move should be kept for ply 0
**** and put with the resulting board, for use in identifying path for book moves.
LM Now get the byte designation
LR 5,A
SR 1
SR 1
NI H'3' Separate the byte indicator part
LR 4,A Save it in 4
LR A,5
NI H'13' Separate the JUMP bit and the direction
LR 5,A Save them in 5
*Now process ACTIVE and KINGS for source deletion
DELE PI GMEN
XS 6 Delete moving piece
LR S,A from byte
LISU KLOC To get to corresponding KING byte
LR A,S
NS 6 Was the piece a king?
BZ DEL2
XS S If it was delete king bit
LR S,A
LIS H'7' Non-zero in 2 for king
DEL2 LR 2,A Save as a flag for kind of piece moving
*Now locate captured piece if jump or find destination in normal move
LR A,6 Recall MOVE bit
SR 4
BZ INRH Bit was in right half of byte
INLH LR 3,A Save partially shifted MOVE bit
LR A,5 Get direction
NI H'1' To test right-most bit
BZ INL2 RF or LB move where 4 shift is correct
LR A,3
SR 1 LF and LB require an additional shift
LR 3,A
INL2 LR A,5 Now test for fore or aft
NI H'2'
BZ BOTH Forward move, no byte shift needed
LR A,D Only to decrement ISAR
INL3 BR BOTH
*
INRH LR A,6 Get MOVE bit again
SL 4 Left shift if in right half
LR 3,A Save partially shifted MOVE bit
LR A,5 Get direction
NI H'1'
BNZ INR2 LF or RB wwhere 4 shift is correct
LR A,3
SL 1 RF and RB require an additional shift
LR 3,A
INR2 LR A,5 Now test fore and aft
NI H'2'
BNZ BOTH
LR A,I Only to increment ISAR
*Now we are ready to decide if jump or not
BOTH CLR
LR 0,A Used temporarily to accumulate piece debit
LR A,5 Now is this a jump or a normal move?
SR 4
BNZ BOT1
JMP NORM It's a normal move
BOT1 JMP JUMP
* JUMP
*
JUMP LR A,S Get King Byte corresponding to captured piece
NS 3 Was piece a king?
BZ JUM1 No
XS 3 Delete it
LR S,A And replace byte
LR A,0
INC Count 1 extra for king
LR 0,A
JUM1 LIS H'2'
AS 0 Count 2 for piece capture
LR 0,A
LISU PLOC Get back to right buffer for ACTI and PASS
LR A,IS
AI 4 Increment to PASSIVE byte
LR IS,A
LR A,S Get appropiate PASSIVE byte
XS 3 Delete capture
LR S,A And return byte
LISU PLOC Back to moved-from location
LISL 0
LR A,IS
AS 4 Byte number is in 4
LR IS,A
LR A,5 Get direction
NI H'1' Test for right or left
BZ JUM2
LR A,6 It's to the left
SR 1 Left moves involve a right shift of 1
BR JUM3
JUM2 LR A,6 It's to the right
SL 1 Right moves involve a left shift of 1
JUM3 LR 3,A Save displaced bit in 3
LR A,5
NI H'2' Test for fore or aft
BZ JUM4 Fore move
LR A,D Decrement ISAR (destination always in next byte)
LR A,4
AI H'FF' Correct to destination byte number
LR A,2 Was the piece a king?
NS 2
BNZ JUM6 Yes, so not necessary to test for a promotion
LR A,IS Backward non-king must be white
CI O'30' Is this WHITE's king row
BNZ JUM7 No, so there may still be a double jump
BR JUM5 Promotion indicated, so no double jump possible
JUM4 LR A,I Increment ISAR
LR A,4
AI H'1' Correct to destination byte number
LR 4,A We'll need this for continuation
LR A,2 Was the piece a king?
NS 2
BNZ JUM6 Yes, so not necessary to test for promotion
LR A,IS Forward non-king must be black
CI O'33' Is this BLACK's king row
BNZ JUM7 No, so there may still be a double jump
*Promotion indicated, do it and set 2 to flag bypass of double jump prepare
JUM5 LIS H'1' Non-zero (but not 7) for promotion
LR 2,A It is so promote piece
LR A,0
INC Add 1 to debit account
LR 0,A
JUM6 LR A,S Now get right byte
AS 3 Insert piece
LR S,A
LR A,IS Prepare to deposit king
AI 7 Go to correct king byte
LR IS,A
JUM7 LISL 4 Get to piece debit position
LR A,S
SR 4 Note that right part is zero'ed
SR 1
AS 0
CI H'7' Limit size to 7
BP JU7M
LI H'7'
JU7M SL 4
SL 1
LR S,A
LR A,2
CI H'1' Was it by promotion?
BZ JUM9 It was, so no double jump prepare
*Now we must anticipate a forked double jump
*See the detailed explanation of multiple jumps on page 3.
LR DC,H Do not advance H yet
LI H'20' Copy data two blocks forward
ADC
LISU PLOC
LISL 0
LIS H'8'
LR 0,A
PI SCRL Active and passive pieces
LISU KLOC
LISL 0
LIS H'4'
LR 0,A
PI SCRL
LIS H'4'
LR 0,A
LR Q,DC
XDC
LR DC,Q
LI H'E0' Last 4 bytes come from current RAM data
ADC
JUM8 LM
XDC
ST
XDC
DS 0
BNZ JUM8
*Now save the board in anticipation of no double jump
JUM9 LR DC,H (Do not yet advance H)
LI H'10'
ADC
PI SCRA
*Now look into double jump situation
LR A,2
CI H'1' Was there a promotion?
BNZ DOUB No, so may be a double jump
LR DC,H Finally ready to advance H
LI H'10'
ADC
LR H,DC
*We get here from FIND (with H reset) if no continuation possible
DOUX LR A,7
COM
LR 7,A
JMP FIND
DOUB LR DC,H Advance H by 2
LI H'1C'
ADC
LR A,3 Needed if continuation is successful
ST It will be overwritten if not
LR A,4
ST
LR DC,H
LI H'20'
ADC
LR H,DC
LR A,11
SR 4
XDC
DCI MOBS
AI H'FD' stored back by 3
ADC Will never be too early
LIS H'F' Used to signal a continuation
LR 6,A
ST Set continuation signal
XDC get back
PI RASC Load scratchpad
JMP RFJ
* NORM FORE
*
*Now make normal move
NORM LISU PLOC Get back to Active pieces
LR A,S
AS 3
LR S,A Put in moved piece
LR A,2 Was it a king
NS 2
BNZ NOM6 Yes so don't promote but do put king down
LR A,5
NI H'2' Test for direction
BZ NOM4 Black is active
LR A,IS
CI H'30' Did it get to the white king row?
BZ NOM5 Yes, so promote
BR FORE
NOM4 LR A,IS Black is active
CI H'33' Did it get to the king row?
BNZ FORE No
NOM5 LIS H'1'
LR 0,A
NOM6 LISU KLOC Now get to king byte
LR A,S Get corresponding king byte for destination
AS 3 Insert king
LR S,A And replace byte
LR A,0
NS 0
BZ FORE
LISL 4 Now fix the piece debit
LR A,S
SR 4
SR 1
INC
CI H'7'
BP NOM7
LI H'7'
NOM7 SL 4
SL 1
LR S,A
FORE LR DC,H
LI H'10'
ADC To next board record
LR H,DC
PI SCRA Save newly created board record
LR A,7
COM Reverse color
LR 7,A
PI RASC Get correct board into SC
JMP FIND
* EVAL
*
EVAL LR A,11 We'll need the ply value
SR 4
AI H'FF'
LR 5,A We'll need it again
AI H'FD' MOBS indexes 2 less and we want one earlier
LR DC,H
ADC
LM Get earlier mobility
SR 4 It was shifted to pack
COM
INC
AS 2 Add current mobility
CI H'7' Difference limited to absolute 7
BP EVAA
LI H'7'
EVAA CI H'F9'
BM EVAB
LI H'F9'
EVAB SL 4 Make room for ply term
LR 6,A Save difference (and free 2)
*Now look to the first term
LR DC,H Make sure this is correct
LIS H'C' To get current board piece debit
ADC
LISU KLOC
LISL 5 To get previous board piece debit
LR A,I
SR 4
SR 1
LR 2,A Piece credit for ACTIVE
LM Now the current board
SR 4
SR 1
LR 1,A Piece credit for PASSIVE
LR 0,A Save it twice
COM
INC Make it a true negation
AS 2
LR 4,A Save for its sign
BZ EVA7 No material advantage
BP EVA2
COM
INC Make it a true negation
LR 1,A
LR A,0 This was the larger
LR 2,A
EVA2 LR A,2
AI 2 Increase larger by 2
LR 2,A
PI MPYR Multiply 2 by 1
LR A,4
NS 4
BP EVA3
LR A,0
COM Note not true negation
INC
LR 0,A The Piece score
LR A,5
BR EVA4
EVA3 LR A,5
COM
INC
EVA4 AS 6 Add in the mobility term
LR 6,A Completed positional term
LR A,5
EV4A CI H'2' Are we far enough along to be able to prune?
BP EVA5 No
LR A,0 Now get material advantage term back
CM Compare with value brought forward 2 levels
BM EVA5 Can not alphe-beta prune
BNZ EVA9 In this case we can for sure
*We have to compare second score terms in this case
LR A,6
CM
BP EVA9 We can prune
EVA5 LR DC,H Otherwise back 1 level
LI H'F0'
ADC
LR H,DC
LIS H'E'
ADC
LR A,0
COM
INC
CM
BM EVA6 Back score for sure
BNZ EVA8 Do not back score for sure
LR A,0
COM
INC
CM
BP EVA8 Do not back score
EVA6 LR DC,H
LIS H'E'
ADC Get back to first score term
LR A,0
COM
INC
ST
LR A,6
COM
INC
ST
LR A,5 Where are we?
CI 2
BNZ EVA8 Not going back to the first board
LI H'10' Prepare to save this board
LR 0,A
LR DC,H
EVA7 LM
LR 1,A
LI H'DF'
ADC
LR A,1
ST
LI H'E0'
ADC
LR A,0
AI H'FF'
LR 0,A
BNZ EVA7
EVA8 LR DC,H
LI H'F0'
ADC
LR H,DC
JMP SELE
EVA9 NOP **** This code needs fixing
* SQIN SQOU MVIN
*
*Subroutine to accept a square number in std. checker notation in SC 1 and
*to return a byte number in SC 2 and a MOVE byte (with 1 bit on) in SC 3.
*SC 0 is used.
SQIN LR K,P
LR A,1
AI H'FF' Change range to 0 thru 31
LR 0,A
SR 1
SR 1
SR 1 Divide by 8
LR 2,A This is the byte number
LR A,0
NI H'7'
LR 0,A
LI H'80' A bit in position 7 (squares 1, 9, 17 or 25)
BR SQI2
SQI1 LR A,3
SR 1
SQI2 LR 3,A
LR A,0
AI H'FF'
LR 0,A
BNZ SQI1
PK
*
*Subroutine to accept a byte number in 2 and a MOVE byte in 3 and to return
*a square number in standard checker notation in 1.
*
SQOU LR K,P
LR A,2
SL 1
SL 1
SL 1 Multiiply by 8
LR 1,A
SQO1 LR A,1
INC
LR 1,A
LR A,3
SL 1
LR 3,A
BP SQO1
PK
*
*Subroutine to analyse an input move (received as two numbers in 1 and 2)
*and to verify that the move is acceptable.
*
*The general scheme is to verify certain aspects of the proposed move and
*to extract the direction indicator from it. A call to FIND will then verify
*that this move is indeed possible.
*
****THIS CODE IS MUCH TOO LONG. THERE MUST BE A BETTER WAY.
**** We must also decide on the number of messages that we may want to
*generate. This code assumes only three: 1) "You must JUMP", 2) "Try again",
*or perhaps "Illegal move" and 3) "O.K.".
*
MVIN CLR
LR 11,A
LR DC,H
LIS H'E'
ADC
LM
NI 1 Extract J
LR 3,A Save as required Jump flag
LR A,1
COM
INC
AS 2
LR 4,A Save for front or back move signal
BP MVI2
COM
INC
MVI2 LR 5,A Save magnitude of difference
CI 6
BM MVJ1 Seems to be a jump move
LR A,1
NI 1
BZ MVN2 Normal move called for
JMP ERR1 An error, Jump is required
MVN2 CI 3
BZ MVN3 Must be RF or LB
CI 5
BZ MVN4 Must be LF or RB
CI 4
BZ MVN5 Can not decide yet
JMP ERR2 An error, normal move required
MVN5 LR A,1
AI H'FF' Subtract 1
NI 4 Which half of byte
BNZ MVN4 Must be LF or RB
MVN3 LR A,4 A RF or LB
NS 4
BM MVN6
CLR RF
BR MVI3
MVN6 LIS H'3' LB
BR MVI3
MVN4 LR A,4
NS 4
BM MVN7
LIS H'1' LF
BR MVI3
MVN7 LIS H'2' RB
BR MVI3
*
MVJ1 LR A,1
NI 1
BNZ MVJ2
JMP ERR2 An error, normal move required
MVJ2 LR A,5
CI H'7'
BZ MVJ3 It's either RFJ or LBJ
CI 9
BZ MVJ5 It's either LFJ or RBJ
JMP ERR1 An error, jump is required
MVJ3 LR A,4
NS 4
BM MVJ4
LI H'10' RFJ
BR MVI3
MVJ4 LI H'13' LBJ
BR MVI3
MVJ5 LR A,4
NS 4
BM MVJ6
LI H'11' LFJ
BR MVI3
MVJ6 LI H'12' RBJ
BR MVI3
MVI3 LR 0,A Save temporarily
**** Now we must fix matters so that FIND may be called to see if this is
*a legel move
**** Then we do the following
*
PI SQIN Get byte number into 2 and move byte into 3
LR DC,H
PI RASC
LR DC,H
LR A,3
LR 6,A
*
LR A,2
SL 1
SL 1
AS 0 THIS HAS THE JUMP BIT IN H'10'
*
ERR1 NOP **** Must send error message
ERR2 NOP **** Must send error message
**** This has the JUMP bit in the original FLAG byte
**** We are about ready to enter SELECT at DELE but some fixing necessary
* TELL
* Subroutine to get machine's move into standard checker notation
TELL LR K,P
PI PUSH
CLR
LR 0,A **** IS THIS RIGHTT
PI TELX
LR 2,A Save bits that differ
COM
INC
NS 2
LR 3,A This is one bit
NS 1 Is it the destination?
BZ TEL1
LI H'10'
TEL1 LR 4,A The destination signsl
LR A,0
COM
AS 4
LR 4,A In this byte
LR A,3
NS 1 Is there another? ***** CHECK THIS
BNZ TEL2 There is
PI TELX
TEL2 LR 5,A The second bit
NS 1
BZ TEL3
LIS H'10'
TEL3 LR 6,A
LR A,0
COM
AS 6
LR 6,A
PI POPS
PK
TELX LR K,P
LM Get passive byte from players board
LR 1,A
XDC
XM XM with active byte from machines board
XDC
DS 0
BZ TELX No change in this byte
PK
* BOOK
*Code to read stored book moves
*
BOOK DCI TREE
LR H,DC
XDC
DCI STOR
*Opening move table (choice to be made by a random number from 0 thru 7
BOK1 DC H'01' 12-16, 11-15
DC H'23' 10-14, 9-13
DC H'45' 11-16, 10-15
DC H'61' 9-14, 11-15
*First replies (maximum of 4 each)
BOK2 DC H'33' 24,20 24-20 To 12-16
DC H'33' 24-20, 24-20
BOKB DC H'43' 23-19, 24-20 To 11-15
DC H'20' 22-17, 24-19
BOKC DC H'22' 22-17, 22-17 To 10-14
DC H'22' 22-17, 22-17
BOKD DC H'55' 22-18, 22-18 To 9-13
DC H'55' 22-18, 22-18
BOKE DC H'31' 24-20, 23-18 To 11-16
DC H'45' 24-19, 22-18
BOKF DC H'66' 21-17, 21-17 To 10-15
DC H'66' 21-17, 21-17
BOKG DC H'55' 22-18, 22-18 To 9-14
DC H'55' 22-18, 22-18
*First counter replies (maximum of 2 each)
BOK3 DC To 12-16 24-19
DC To 12-16 23-18
DC To 12-16 22-17
DC H'00' 8-12, 8,12 To 12-16 24-20
DC H'00' 16-23, 16,23 To 12-16 23-19
DC To 12-16 22-18
DC To 12-16 21-17
DC H'00' 15-24, 15-24 To 11-15 24-19
DC H'00' 8-11, 8-11 To 11-15 23-18
DC H'60 9-13, 8-11 To 11-15 22-17
DC H'00' 8-11, 8-11 To 11-15 24-20
DC H'05 8-11, 9-14 To 11-15 23-19
DC H'00' 15-22, 15-22 To 11-15 22-18
DC To 11-15 21-17
**** THERE WILL BE 49 BYTES OF THESE, EACH WITH 2 COUNTER REPLIES
**** The ones listed at present are from Lee's Guide